      PROGRAM FORCST
C
!     THE FOLLOWING CHANGES HAVE BEEN MADE AS OF THE DATE SPECIFIED.
!      1. LOGIC TO BLANK OUT AVERAGE ACCUMULATION OF SNOW AND SOIL MOISTURE
!         WHEN THE CURRENT MONTH BEING RUN IS EQUAL OR GREATER THAN THE FINAL
!         MONTH SNOW OR SOIL MOISTURE IS FORECAST.    5/84
!      2. LOGIC CHANGES SO IF PAST MONTHS FORECAST NEED TO BE RERUN, THEN
!         ESTIMATED PRECIPITATION IS USED FOR ALL MONTHS FROM MONTH OF FORECAST
!         ON.    5/84
!      3. CHANGES MADE TO OUTPUT FILE NAMED DATEJUL.OUT (UNIT=22) TO INCLUDE
!         MONTH FORECAST IS RUN TO.  IT WILL BE IN COLUMNS 4,5, AND 6.    5/84
!      4. CHANGES MADE TO HANDLE MID-MONTH FORECASTS.    5/84
!      5. CHANGE TO WRITE STATEMENTS FOR UNIT 22 & FORMAT 150 TO PUT FORECAST
!         ON EACH RECORD.  10/26/84
!      6. ALLOW SEPT. RUNOFF TO PRINT ON MAIN OUTPUT FOR RUNOFF RUN
!         OCT.-SEPT.  10/26/84
!      7. CODE 17-UNREGULATED STREAM FLOW PUT IN, DATA IS HANDLED AS
!         A GAGE.    10/26/84
!      8. ALLOW MONTH OF FORECAST & FIRST MONTH OF RUNOFF OR NATURAL
!         TO BE SAME MONTH & PRINTOUT CORRECTLY  1/18/85
!        3. LOGIC CHANGE TO PUT AVERAGE ANTECEDENT RUNOFF IN AS CODE 17
!           (UNREGULATED FLOW) WHEN AVERAGE IS REQUIRED.  3/13/85
!      9. LOGIC PUT IN FOR HISTORICAL RUNS TO KEEP NEGATIVE RUNOFF
!         AND NEGATIVE ANTECEDENT RUNOFF FROM BEING INCLUDED IN THE
!         TOTALS.  12/87
C
      DIMENSION IEQUAT(3),             WGHTM(12,8), NAMEST(3,30)
      DIMENSION ITYPS(8,30), SWGHT(8,30),            NAMES(3) 
      DIMENSION DATAR(12),            JSITE(8), PRECIP(12,10) 
      DIMENSION EPRECP(12,10), SNOW(12,10), SOIL(12,10), ESNOW(12,10) 
      DIMENSION ESOIL(12,10), CANAL(12,2,10), GAGE(12,2,10) 
      DIMENSION EOM(12,2,10), OUTFLO(12,2,10),IEST(12,10,12), TOT(12) 
      DIMENSION ETOT(12), DATAA(9),  TSNOW(12,10), JTYPS(12)
      DIMENSION MNTH(12), DELTA(12,2,10), INFLOW(12,2,10) 
      DIMENSION SINFLO(12,2,10), ROCOMP(5,3,24), ROCNAM(3,3)
      DIMENSION NATURL(16,24),   NATNAM(3,15) 
      DIMENSION       COEF(5,4), NAME(3,4), IHEAD(2)
      DIMENSION FRCAST(5), DATEFC(5), ITYPE(4)
      DIMENSION DATAB(12),IESTOT(12,12)
      DIMENSION NAMEPR(3,10), NAMESW(3,10), NAMESM(3,10)
      DIMENSION TSOIL(12,10),IC(5)
      DIMENSION NAMERO(3,10)
      DIMENSION XABOVE(4), XBELOW(4), SNWABV(10), SNWBLW(10)
      DIMENSION SOLABV(10), SOLBLW(10), FRCABV(5), FRCBLW(5)
      DIMENSION DATABV(5), DATBLW(5), NMDAY(12)
      DIMENSION ESNOWM(10), ESOILM(10), EANTECD(12)
      COMMON/PRNT/ XA(8), IXA(4), IESTX(8), IX(4), IDATA(5,8), X(4),
     1             IXEST, LD, LR,LC 
      REAL    INFLOW, NATURL
      CHARACTER IHEAD*6, itype*10,NAMES*10,rocnam*10,name*10
      CHARACTER DATAA*10,DATAB*7,NAMEPR*10,natnam*10
      CHARACTER NAMESW*10,NAMESM*10,NAMERO*10,NAMEST*10
      CHARACTER MNTHF*9,IEQUAT*10,DATEC*9
      CHARACTER AVGACCM*11,KDAY*2
C 
C     IDT=FILE CONTAINING ALL REQUIRED SITE DATA, IFC=FORECAST EQUATION 
C     FILE FOR THIS RUN, ICOE=COEFFICIENT FILE, IO=MAIN OUTPUT FILE FOR 
C     PRINTER, IOA=MAIN OUTPUT FILE FOR LISTING ON TS, IOB=RUNOFF 
C     COMPUTATION FILE, IOER=ERROR FILE 
      DATA IDT, IFC, ICOE, IO,  IOER / 5, 14, 13, 6,  
     116 /,IOF/20/
      DATA JTYPS /1HC, 1HG, 1HP, 1HI, 1HS, 1HM, 1HE, 1HO, 1HD, 1HA, 1HN,
     11HR / 
      DATA IX /2HX1, 2HX2, 2HX3, 2HX4 / 
      DATA MNTH /3HOCT, 3HNOV, 3HDEC, 3HJAN, 3HFEB, 3HMAR, 3HAPR, 
     13HMAY, 3HJUN, 3HJUL, 3HAUG, 3HSEP / 
      DATA NMDAY / 31,30,31,31,28,31,30,31,30,31,31,30 /
      DATA IHEAD /'RUNOFF',  'SUM RO'/
      DATA IXA / 1HA, 1HB, 1HC, 1HD / 
      DATA IC / 2HC1, 2HC2, 2HC3, 2HC4, 2H K /
      CALL DATE(DATEC)
      WRITE(IOER,5) DATEC 
    5 FORMAT('0', 'ERROR FILE FOR FORECAST PROGRAM', A10 / )
      REWIND IDT
      REWIND IFC
      NMRD = 0
  570 IERR = 0
      JERR = 0
      JR = 0
      JN = 0
      DO 576 I = 1,10 
      DO 574 J = 1,2
      DO 572 M = 1,12 
  572 SINFLO(M,J,I) = 0.0 
  574 CONTINUE
  576 CONTINUE
      DO 580 L = 1,4
  580 IESTX(L) = ' ' 
      DO 595 I = 1,12
      EANTECD(I)=0.0
      DO 590 M = 1,12 
      IESTOT(M,I) = ' '
      DO 585 J = 1,10 
  585 IEST(M,J,I) = ' '
  590 CONTINUE
  595 CONTINUE
C     READ EQUATION DATA FOR ONE EQUATION AT A TIME 
  605 READ(IFC,10,END=1800) IEQUAT, NMXS, NMBASN, NMSITE, MNTHFC, 
     1MNTHF,IYEAR,PCTABV,PCTBLW,IANTMO
   10 FORMAT(3A10, 3I2, A3,A9,I4,2F6.2,I2) 
      PCTABV = PCTABV / 100.0 
      PCTBLW = PCTBLW / 100.0 
  610 NMXST = NMXS + NMBASN 
      DO 615 M = 1,12 
      IF(MNTHFC .EQ. MNTH(M)) THEN 
         MCURNT = M
         MUSE=M
         IF(M .EQ. 1) MCURNT = 12
         GO TO 617
      END IF
  615 CONTINUE
C
C     SELECT DAY FROM MONTH AND DAY OF FORECAST RUN.
  617 MI=INDEX(MNTHF,' ')
      IF(MNTHF(MI+2:MI+2) .EQ. ' ') THEN
        READ(MNTHF(MI+1:MI+1),'(I1)') IDAY
        ELSE
        READ(MNTHF(MI+1:MI+2),'(I2)') IDAY
      END IF
C     LEAP YEAR LOGIC
      IF(IYEAR/4*4 .EQ. IYEAR) NMDAY(5)=29
C
C     DETERMINE IF THIS IS A MID-MONTH RUN.
      IF(IDAY .GT. 1) THEN
        MID = MUSE
        MUSE = MUSE + 1
        ELSE
        MID=0
      END IF
C 
C     READ NON-SITE DATA FROM FORECAST FILE 
C 
      READ(IFC,15)((IDATA(I,J), I = 1,5), J = 1,NMXST ) 
   15 FORMAT( 4(I1, A1, I4, 2A3) )
      READ(IFC,20) ((WGHTM(M,J), M = 1,12), J = 1,NMXS )
   20 FORMAT(12F5.3)
      NMCF = 1
      DO 620 J = 2,NMXS 
      IF(IDATA(1,J) .EQ. IDATA(1,J-1)) GO TO 620
      NMCF = NMCF + 1 
  620 CONTINUE
C     SET FLAG IF RUNOFF DATA IS TO BE PUNCHED
C     FLAG WILL BE SET TO PUNCH IF EQUATION FILE VARIABLE IDATA(2) = R
C     OR N AND IDATA(4) = OCT AND IDATA(5) = SEP
      IPNCHR = 0
      DO 625 J = 1,NMXST
      IF(IDATA(2,J).NE.1HR.AND.IDATA(2,J).NE.1HN) GO TO 625 
      IF(IDATA(4,J).EQ.3HOCT.AND.IDATA(5,J).EQ.3HSEP) IPNCHR = 1
  625 CONTINUE
C 
C     READ SITE DATA FROM FORECAST FILE 
C 
      DO 650 K = 1,NMSITE 
      READ(IFC,25) (NAMEST(I,K), I = 1,3), (ITYPS(J,K), SWGHT(J,K), 
     1J = 1,NMXST)
   25 FORMAT(3A10, 8(A1,F5.3) ) 
  650 CONTINUE
      DO 655 N = 1,8
  655 JSITE(N) = 0
C     READ DATA TO BE USED IN COMPUTING FORECASTS 
      IF(NMRD .NE. 0 ) GO TO 672
  670 READ(IDT,30,END=830) NMF, NAMES, NB, JYEAR, DATAA
   30 FORMAT(I2,3A10,I2,I4,8A10, A4)
      DECODE(84,32,DATAA) (DATAR(M), M = 1,12)
   32 FORMAT(12F7.2)
      DECODE(84,35,DATAA)  (DATAB(M),  M = 1,12)
   35 FORMAT(12A7)
  671 IF(NMRD .NE. 0 ) GO TO 680
      NMRD = 1
  672 KEQUAT    = NMF 
  680 IF(KEQUAT    .NE. NMF       ) GO TO 830 
      NA = NB 
  !       FOLLOWING STATEMENT ADDED.  #3 ABOVE
      IF(NA .EQ. 10) GO TO 820
      IF(NA .GT. 20) NA=NA-20
      GO TO (780,780,690,780,730,730,780,780), NA 
C 
C     PRECIP DATA 
C 
  690 IF(NB .GT. 20) GO TO 710
C
C     INITIALIZE DATA THAT WILL NOT BE SAVED.
      DO 691 M=MUSE,12
      DATAR(M)=0.0
      DATAB(M)='       '
  691 CONTINUE
      JSITE(NA)= JSITE(NA) + 1
      JA = JSITE(NA)
      DO 692 I = 1,3
      NAMEPR(I,JA) = NAMES(I) 
  692 CONTINUE
      DO 700 M = 1,12 
      IF(DATAB(M).NE.'       ') GO TO 695
      IEST(M,JA,3) = 1HE
      IESTOT(M,3) = 1HE 
  695 PRECIP(M,JA) = DATAR(M) 
  700 CONTINUE
      GO TO 670 
  710 JA = JSITE(NA)
      DO 715 M = 1,12 
      EPRECP(M,JA) = DATAR(M) 
  715 CONTINUE
      GO TO 670 
C 
C     SNOW AND SOIL MOISTURE
C 
  730 IF(NB .GT. 20 ) GO TO 750 
C     INITIALIZE DATA THAT WILL NOT BE USED
      DO 720 M=MUSE+1,12
      DATAR(M)=0.0
      DATAB(M)='       '
  720 CONTINUE
C     INPUT SNOW WATER CONTENT.
      JSITE(NA) = JSITE(NA) + 1 
      JA = JSITE(NA)
      IF(NA .GT. 5) GO TO 740 
      DO 732 I = 1,3
      NAMESW(I,JA) = NAMES(I) 
  732 CONTINUE
      DO 735 M = 1,12 
      IF(DATAB(M) .NE. '       ' ) GO TO 735 
      IEST(M,JA,5) = 1HE
      IESTOT(M,5) = 1HE 
  735 SNOW(M,JA) = DATAR(M) 
      GO TO 670 
C     INPUT SOIL MOISTURE
  740 DO 745 M = 1,12 
      IF(DATAB(M) .NE. '       ' ) GO TO 745 
      IEST(M,JA,6) = 1HE
      IESTOT(M,6) = 1HE 
      IESTX(6) = 1HE
  745 SOIL(M,JA) = DATAR(M) 
      DO 747 I = 1,3
      NAMESM(I,JA) = NAMES(I) 
  747 CONTINUE
      GO TO 670 
  750 JA = JSITE(NA)
      IF(NA .GT. 5) GO TO 760 
C     INPUT ESTIMATED SNOW WATER CONTENT
      DO 755 M = 1,12 
  755 ESNOW(M,JA) = DATAR(M)
      GO TO 670 
C     INPUT ESTIMATED SOIL MOISTURE
  760 DO 765 M = 1,12 
  765 ESOIL(M,JA) = DATAR(M)
      GO TO 670 
C 
C     RUNOFF DATA 
C 
  780 NY = 2
      IF(JYEAR .LT. IYEAR) NY = 1 
      IF(NY .EQ. 1 ) THEN
      JSITE(NA) = JSITE(NA) + 1 
      JA = JSITE(NA)
      ELSE
C     INITIALIZE DATA THAT WILL NOT BE USED
      DO 784 M=MUSE,12
      DATAR(M)=0.0
      DATAB(M)='       '
  784 CONTINUE
      END IF
      IF(NA .GT. 2 ) GO TO 800
      IF(NA .GT. 1 ) GO TO 790
      DO 785 M = 1,12 
  785 CANAL(M,NY,JA) = DATAR(M) 
      GO TO 670 
  790 DO 795 M = 1,12 
  795 GAGE(M,NY,JA) = DATAR(M)
      GO TO 670 
  800 IF(NA .GT. 7 ) GO TO 810
      DO 805 M=1,12 
  805 EOM(M,NY,JA) = DATAR(M) 
      DO 807 I = 1,3
      NAMERO(I,JA) = NAMES(I) 
  807 CONTINUE
      GO TO 670 
  810 DO 815 M = 1,12 
  815 OUTFLO(M,NY,JA) = DATAR(M)
      GO TO 670 
!       FOLLOWING 3 STATEMENTS ADDED.  #3 ABOVE
  820 DO 825 M=MUSE,12
      EANTECD(M)=DATAR(M)
  825 CONTINUE
      GO TO 670
C 
C     PROCESS DATA - MAKE ESTIMATES WHERE NECESSARY AND COMPUTE X VALUES
C     DELTA CONTENTS, INFLOWS AND NATURAL FLOWS 
C 
C     ESTIMATE ANY DATA NOT AVAILABLE 
C 
  830 CONTINUE
      DO 840 M = 1,12 
      TOT(M) = 0.0
      ETOT(M) = 0.0 
  840 CONTINUE
      DO 844 L = 1,NMXST
      IF(IDATA(2,L) .EQ. JTYPS(5) ) LA = L
      IF(IDATA(2,L) .EQ. JTYPS(6)) LB=L 
      DO 842 I = 1,12 
      IF(IDATA(2,L) .EQ. JTYPS(I) ) IDATA(2,L) = I
      IF(IDATA(4,L) .EQ. MNTH(I) ) IDATA(4,L) = I 
      IF(IDATA(5,L) .EQ. MNTH(I) ) IDATA(5,L) = I 
  842 CONTINUE
  844 CONTINUE
      IF(JSITE(3) .EQ. 0 ) GO TO 890
C 
C     ESTIMATE PRECIP IF REQUIRED 
C 
      JA = JSITE(3) 
      DO 855 M = 1,12 
      DO 850 J = 1,JA 
      IF(IEST(M,J,3) .EQ. 1HE) GO TO 850
      TOT(M) = TOT(M) + PRECIP(M,J) 
      ETOT(M) = ETOT(M) + EPRECP(M,J) 
  850 CONTINUE
  855 CONTINUE
      RATIO=1.0
      FRATIO=0.0
      DO 870 M = 1,12 
C
C     DETERMINE IF MONTH IS THE MONTH OF PARTIAL DATA.
      IF(MID .EQ. M) THEN
        DAY=IDAY
        DAYS=NMDAY(M)
        RATIO=DAY/DAYS
        FRATIO=(DAYS-DAY)/DAYS
      END IF
      DO 865 J = 1,JA 
      IF(IEST(M,J,3).EQ.1H ) THEN
        PRECIP(M,J)=PRECIP(M,J)+FRATIO*EPRECP(M,J)
        IF(MID .NE. M) GO TO 865
        IEST(M,J,3)=1HE
        IESTOT(M,3)=1HE
        ELSE IF(TOT(M) .EQ. 0.0 ) THEN
        PRECIP(M,J) = EPRECP(M,J) 
        ELSE 
  860   PRECIP(M,J) =RATIO* EPRECP(M,J) * TOT(M) /(RATIO*ETOT(M))
        PRECIP(M,J)=PRECIP(M,J) + FRATIO*EPRECP(M,J)
      END IF
  865 CONTINUE
      IF(MID .EQ. M) THEN
        RATIO=1.0
        FRATIO=0.0
      END IF
  870 CONTINUE
  890 IF(JSITE(5) .EQ. 0 ) GO TO 925
C 
C     ESTIMATE SNOW WATER CONTENT IF REQUIRED 
C     TSNOW(M,J)=AVE. ACCUM. NOT NORMAL
C     ESNOW(M,J)=NORMAL NOT AVE. ACCUM.
C 
      DO 895 M = 1,12 
      TOT(M) = 0.0
      ETOT(M) = 0.0 
  895 CONTINUE
      JA = JSITE(5) 
      DO 897 J = 1,JA 
      SNWABV(J) = 0.0 
      SNWBLW(J) = 0.0 
  897 CONTINUE
      M = MCURNT
      MO = IDATA(5,LA)
      MP=MO+1
      IF(M .GT. MO) M = MO
      DAYSM=0.0
      RATIO=1.0
      FRATIO=1.0
      MS=M
      IF(IDAY .LE. 1)GO TO 898
      IF(M .GE. MO) GO TO 898
      MS=M+1
      DAY=IDAY
      DAYS=NMDAY(M)
CC    DO 1700 MA=M,MO-1
CC    DAYSM=DAYSM+NMDAY(MA)
CC1700 CONTINUE
      RATIO=DAY/DAYS
      FRATIO=(DAYS-DAY)/DAYS
  898 DO 905 J = 1,JA 
C     NORMAL CALCULATION ESNOWM(J)
      ESNOWM(J)=RATIO*(ESNOW(MS,J)-ESNOW(M,J)) + ESNOW(M,J)
      TOT(M) = TOT(M) + SNOW(MS,J) 
      IF(M .GE.MO) GO TO 902
CC    TSNOW(M,J) = ESNOW(MO,J)
CC    GO TO 902 
      TSNOW(MS,J) = ESNOW(MO,J)- ESNOWM(J)
  902 IF(IEST(MS,J,5) .EQ. 1HE) GO TO 905
      ETOT(M) = ETOT(M) + ESNOWM(J)
  905 CONTINUE
      IF(JA.GT. 1) GO TO 907
C     FOLLOWING LOGIC FOR ONLY 1 SNOW SITE
      IF(IEST(MS,JA,5) .EQ. 1H ) GO TO 1905
      SNOW(MS,JA) = ESNOWM(JA)
 1905 IF(M .GE. MO) GO TO 906 
CC    IF(IDAY .GT. 1) IEST(MS,JA,5)=1HE
      SNOW(MP,JA) = SNOW(MS,JA) + TSNOW(MS,JA)
      SNWABV(JA) = SNOW(MS,JA) + TSNOW(MS,JA) * PCTABV
      SNWBLW(JA) = SNOW(MS,JA) + TSNOW(MS,JA) * PCTBLW
      GO TO 925 
  906 SNWABV(JA) = SNOW(M,JA) 
      SNWBLW(JA) = SNOW(M,JA) 
      SNOW(MP,JA)=SNOW(M,JA)
      GO TO 925 
C     FOLLOWING LOGIC FOR MORE THAN 1 SNOW SITE
  907 DO 920 J = 1,JA 
      IF(IEST(MS,J,5) .EQ. 1H ) GO TO 910
      SNOW(MS,J)  = ESNOWM(J) * TOT(M)/ETOT(M)
  910 IF(M .GE.MO) GO TO 915
CC    IF(IDAY .GT. 1) IEST(MS,J,5)=1HE
      SNOW(MP,J)= SNOW(MS,J) + TSNOW(MS,J)
      SNWABV(J) = SNWABV(J) + SNOW(MS,J) + TSNOW(MS,J) * PCTABV 
      SNWBLW(J) = SNWBLW(J) + SNOW(MS,J) + TSNOW(MS,J) * PCTBLW 
      GO TO 920 
  915 SNWABV(J) = SNWABV(J) + SNOW(MO,J)
      SNWBLW(J) = SNWBLW(J) + SNOW(MO,J)
      SNOW(MP,J)=SNOW(MO,J)
  920 CONTINUE
C 
C     ESTIMATE SOIL MOISTURE IF REQUIRED
C 
  925 IF(JSITE(6) .EQ. 0 ) GO TO 950
      DO 930 M = 1,12 
      TOT(M) = 0.0
      ETOT(M) = 0.0 
  930 CONTINUE
      JA = JSITE(6) 
      DO 932 J = 1,JA 
      SOLABV(J) = 0.0 
      SOLBLW(J) = 0.0 
  932 CONTINUE
      M = MCURNT
      MO = IDATA(5,LB)
      MP=MO+1
      IF(M .GT. MO) M = MO
      DAYSM=0.0
      RATIO=1.0
      FRATIO=1.0
      MS=M
      IF(IDAY .LE. 1) GO TO 934
      IF(M .GE. MO) GO TO 934
      MS=M+1
      DAY=IDAY
      DAYS=NMDAY(M)
CC    DO 933 MA=M,MO-1
CC    DAYSM=DAYSM+NMDAY(MA)
CC933 CONTINUE
      RATIO=DAY/DAYS
      FRATIO=(DAYS-DAY)/DAYS
  934 DO 940 J = 1,JA 
C     NORMAL CALCULATION ESOILM(J)
      ESOILM(J)=RATIO*(ESOIL(MS,J)-ESOIL(M,J)) + ESOIL(M,J)
      TOT(M) = TOT(M) + SOIL(MS,J) 
      IF(M .GE.MO) GO TO 937
CC    TSOIL(M,J) = ESOIL(MO,J)
CC    GO TO 937 
      TSOIL(MS,J) = ESOIL(MO,J)- ESOILM(J)
  937 IF(IEST(MS,J,6) .EQ. 1HE) GO TO 940
      ETOT(M) = ETOT(M) + ESOILM(J)
  940 CONTINUE
      IF(JA.GT. 1) GO TO 941
C     FOLLOWING LOGIC FOR ONLY 1 SOIL SITE
      IF(IEST(MS,JA,6) .EQ. 1H ) GO TO 1940
      SOIL(MS,JA) = ESOILM(JA)
 1940 IF(M .GE. MO) GO TO 1941
CC    IF(IDAY .GT. 1) IEST(MS,JA,6)=1HE
      SOIL(MP,JA) = SOIL(MS,JA) + TSOIL(MS,JA)
      SOLABV(JA) = SOIL(MS,JA) + TSOIL(MS,JA) * PCTABV
      SOLBLW(JA) = SOIL(MS,JA) + TSOIL(MS,JA) * PCTBLW
      GO TO 950 
 1941 SOLABV(JA) = SOIL(M,JA) 
      SOLBLW(JA) = SOIL(M,JA) 
      SOIL(MP,JA)=SOIL(M,JA)
      GO TO 950 
C     FOLLOWING LOGIC FOR MORE THAN 1 SOIL SITE
  941 DO 945 J = 1,JA 
      IF(IEST(MS,J,6) .EQ. 1H ) GO TO 943
      SOIL(MS,J)  = ESOILM(J) * TOT(M)/ETOT(M)
  943 IF(M .GE.MO) GO TO 944
CC    IF(IDAY .GT. 1) IEST(MS,J,6)=1HE
      SOIL(MP,J)= SOIL(MS,J) + TSOIL(MS,J)
      SOLABV(J) = SOLABV(J) + SOIL(MS,J) + TSOIL(MS,J) * PCTABV 
      SOLBLW(J) = SOLBLW(J) + SOIL(MS,J) + TSOIL(MS,J) * PCTBLW 
      GO TO 945 
  944 SOLABV(J) = SOLABV(J) + SOIL(M,J) 
      SOLBLW(J) = SOLBLW(J) + SOIL(M,J) 
      SOIL(MP,J)=SOIL(M,J)
  945 CONTINUE
C 
C     PRINT FORECAST HEADING
C 
  950 WRITE(IO,50) IYEAR, MNTHFC, MNTHF,IEQUAT, DATEC 
   50 FORMAT(1H1,I4, 3X, A3,A9, ' FORECAST ', 3A10, 8X, A9 / ) 
      ICODE = 0 
      DO 960 I = 1,4
      XABOVE(I) = 0.0 
      XBELOW(I) = 0.0 
  960 X(I) = 0.0
      LD = 0
      IXEST = ' '
      DO 1540 L= 1,NMXST
      LR = L
      LC = IDATA(1,L) 
      K = IDATA(2,L)
      MB = IDATA(4,L) 
      MO = IDATA(5,L) 
      MP=MO+1
      TSNABV = 0.0
      TSNBLW = 0.0
      TSLABV = 0.0
      TSLBLW = 0.0
      XA(L)= 0.0
      GO TO (1050,1050,970,1050,1020,1035,1050,1050,1050,1050,1050, 
     11050 ), K 
C 
C     COMPUTE X VALUE FROM PRECIP 
C 
  970 JA =0 
      WRITE(IO,55) IX(LC),MNTH(MB), MNTH(MO), (MNTH(M), M = MB,MO)
   55 FORMAT(1H0,A2,' - ', A3, '-', A3, ' PRECIPITATION (INCHES)' /1H , 
     131X, ' WGHT', 6(4X, A3 )   )
      DO 975 M = MB,MO
      IF(IESTOT(M,3) .EQ. 1HE ) IESTX(L) = 1HE
  975 TOT(M) = 0.0
      DO 995 N = 1,NMSITE 
      IF(ITYPS(L,N) .NE. JTYPS(3) ) GO TO 995 
  977 JA = JA + 1 
      IF(JA .LE. 10) GO TO 978
      JERR = 1
      WRITE(IOER,57) IEQUAT, (NAMEST(I,N), I = 1,3) 
   57 FORMAT(//' FORECAST SPECIFIED ', 3A10/ 1H ,'PRECIP DATA NOT LOCATE
     1D FOR ', 3A10)
      GO TO 1540
  978 DO 980 I = 1,3
      IF(NAMEST(I,N) .NE. NAMEPR(I,JA)) GO TO 977 
  980 CONTINUE
      DO 985 M = MB,MO
      PRECIP(M,JA) = PRECIP(M,JA) * SWGHT(L,N)
      TOT(M) = TOT(M) + PRECIP(M,JA)
  985 CONTINUE
      WRITE(IO,60) (NAMEST(I,N), I = 1,3),SWGHT(L,N), (PRECIP(M,JA),
     1IEST(M,JA,3), M = MB,MO ) 
   60 FORMAT(1H ,3A10, F6.2, 1X,7(F6.2,A1)) 
  995 CONTINUE
      DO 1000 M = MB,MO 
      TOT(M) = TOT(M) * WGHTM(M,L)
      XA(L) = XA(L) + TOT(M)
      IF(M .LT. MCURNT) GO TO 996 
      XABOVE(LC) = XABOVE(LC) + TOT(M) * PCTABV 
      XBELOW(LC) = XBELOW(LC) + TOT(M) * PCTBLW 
      GO TO 1000
  996 XABOVE(LC) = XABOVE(LC) + TOT(M)
      XBELOW(LC) = XBELOW(LC) + TOT(M)
 1000 X(LC)= X(LC)+ TOT(M)
      WRITE(IO,62) ( WGHTM(M,L), M = MB,MO )
   62 FORMAT(1H0, 32X, 'WGHT', 1X, 7(F6.2, 1X) )
      WRITE(IO,65)(TOT(M), IESTOT(M,3), M = MB,MO)
   65 FORMAT(1H ,30X, 'TOTALS', 1X, 7(F6.2, A1 )) 
      CALL PRNTX
      GO TO 1540
C 
C     COMPUTE X VALUE FROM SNOW 
C 
 1020 JA = 0
      M = MCURNT
      IF(MCURNT .LE. MO) GO TO 1023 
      MCURNT = MO 
 1023 MS=MCURNT
      IF(IDAY .LE. 1) GO TO 1025
      IF(M .GE. MO) GO TO 1025
      MS=MCURNT+1
 1025 WRITE(IO,70) IX(LC),MNTH(MO), MNTH(MCURNT), IDAY,MNTH(MO)
   70 FORMAT(1H0, A2, '-',A3,' 1 SNOW (INCHES)'/1H , 32X, 'WGHT',1X,A3, 
     11X,I2,'  NORMAL  AVG.ACCUM. ', 2X, A3, ' 1 ' )
      DO 1030 N = 1,NMSITE
      IF(ITYPS(L,N) .NE. JTYPS(5) ) GO TO 1030
 1026 JA = JA + 1 
      IF(JA.LE.10) GO TO 1027
      JERR=1
      WRITE(IOER,72) IEQUATE,(NAMEST(I,N),I=1,3)
   72 FORMAT(//' FORECAST SPECIFIED ',3A10/
     11H ,'SNOW WATER DATA NOT LOCATED FOR ',3A10)
      GO TO 1540
 1027 DO 1028 I=1,3
      IF(NAMEST(I,N).NE.NAMESW(I,JA)) GO TO 1026
 1028 CONTINUE
      SNOW(MP,JA) = SNOW(MP,JA) * SWGHT(L,N)
      SNWABV(JA) = SNWABV(JA) * SWGHT(L,N)
      SNWBLW(JA) = SNWBLW(JA) * SWGHT(L,N)
      TSNABV = TSNABV + SNWABV(JA)
      TSNBLW = TSNBLW + SNWBLW(JA)
      XA(L) = XA(L) + SNOW(MP,JA) 
C
C     BLANK OUT AVERAGE ACCUMULATION IF MONTH BEING RUN IS EQUAL OR GREATER
C     THAN THE MONTH SNOW IS COMPUTED TO.
      AVGACCM='           '
      IF(MCURNT .LT. MO) THEN
        WRITE(AVGACCM,'(F11.2)') TSNOW(MS,JA)
      END IF
      WRITE(IO,75)(NAMEST(I,N), I = 1,3), SWGHT(L,N), SNOW(MS,JA),  
     1IEST(MS,JA,5), ESNOWM(JA), AVGACCM,  
     2SNOW(MP,JA), IEST(MO,JA,5)
   75 FORMAT(1H , 3A10, F6.2, 1X, F6.2, A1, F6.2, 1X,A11,3X,F6.2,A1)
      IF(MUSE .GT. MO) GO TO 1030
      IF(IEST(MUSE,JA,5) .EQ. 1HE .OR. IEST(MO,JA,5) .EQ. 1HE)
     1 IESTX(L) = 1HE
 1030 CONTINUE
      XA(L) = XA(L) * WGHTM(MO,L) 
      XABOVE(LC) = XABOVE(LC) +TSNABV * WGHTM(MO,L) 
      XBELOW(LC) = XBELOW(LC) + TSNBLW * WGHTM(MO,L)
      X(LC)= X(LC) + XA(L)
      WRITE(IO,77) WGHTM(MO,L)
   77 FORMAT(1H0,61X,'WGHT',F6.2) 
      CALL PRNTX
      MCURNT = M
      GO TO 1540
C     COMPUTE X VALUE FROM SOIL 
C 
 1035 JA = 0
      M = MCURNT
      IF(MCURNT .LE. MO) GO TO 1038 
      MCURNT = MO 
 1038 MS=MCURNT
      IF(IDAY .LE. 1) GO TO 1040
      IF(M .GE. MO) GO TO 1040
      MS=MCURNT+1
 1040 WRITE(IO,82) IX(LC),MNTH(MO), MNTH(MCURNT), IDAY,MNTH(MO)
   82 FORMAT(1H0, A2, '-', A3, ' 1 SOIL MOISTURE (INCHES)' / 1H , 32X,
     1'WGHT',1X,A3, 1X,I2,'  NORMAL  AVG.ACCUM. ', 2X, A3, ' 1 ' )
      DO 1045 N = 1,NMSITE
      IF(ITYPS(L,N) .NE. JTYPS(6) ) GO TO 1045
 1041 JA = JA + 1 
      IF(JA.LE.10) GO TO 1042
      JERR=1
      WRITE(IOER,83) IEQUATE,(NAMEST(I,N),I=1,3)
   83 FORMAT(//' FORECAST SPECIFIED ',3A10/
     11H ,'SOIL MOISTURE DATA NOT LOCATED FOR ',3A10)
      GO TO 1540
 1042 DO 1043 I=1,3
      IF(NAMEST(I,N).NE.NAMESM(I,JA)) GO TO 1041
 1043 CONTINUE
      SOIL(MP,JA) = SOIL(MP,JA) * SWGHT(L,N)
      SOLABV(JA) = SOLABV(JA) * SWGHT(L,N)
      SOLBLW(JA) = SOLBLW(JA) * SWGHT(L,N)
      TSLABV = TSLABV + SOLABV(JA)
      TSLBLW = TSLBLW + SOLBLW(JA)
      XA(L) = XA(L) + SOIL(MP,JA) 
C
C     BLANK OUT AVERAGE ACCUMULATION IF MONTH BEING RUN IS EQUAL OR GREATER
C     THAN THE MONTH SOIL MOISTURE IS COMPUTED TO.
      AVGACCM='           '
      IF(MCURNT .LT. MO) THEN
        WRITE(AVGACCM,'(F11.2)') TSOIL(MS,JA)
      END IF
      WRITE(IO,84)(NAMEST(I,N), I = 1,3), SWGHT(L,N), SOIL(MS,JA),  
     1IEST(MS,JA,6), ESOILM(JA), AVGACCM,  
     2SOIL(MP,JA),IEST(MO,JA,6) 
   84 FORMAT(1H ,3A10,F6.2, 1X, F6.2, A1, F6.2, 1X, A11,3X,F6.2,A1) 
      IF(MUSE .GT. MO) GO TO 1045
      IF(IEST(MUSE,JA,6) .EQ. 1HE .OR. IEST(MO,JA,6) .EQ. 1HE)
     1 IESTX(L) = 1HE
 1045 CONTINUE
      XA(L) = XA(L) * WGHTM(MO,L) 
      XABOVE(LC) = XABOVE(LC) + TSLABV * WGHTM(MO,L)
      XBELOW(LC) = XBELOW(LC) + TSLBLW * WGHTM(MO,L)
      X(LC)= X(LC) + XA(L)
      WRITE(IO,77) WGHTM(MO,L)
      CALL PRNTX
      MCURNT = M
      GO TO 1540
C 
C     COMPUTE DELTAS, INFLOWS, AND NATURAL
C 
 1050 IF(ICODE .NE. 0 ) GO TO 1150
      K = 7 
      JR = 0
      IF(JSITE(K) .EQ. 0) GO TO 1150
      ICODE = 1 
      JA = JSITE(K) 
      DO 1120 J = 1,JA
      NY = 1
      DO 1075 M = 2,12
      DELTA(M,NY,J) = EOM(M,NY,J) - EOM(M-1,NY,J) 
      INFLOW(M,NY,J) = DELTA(M,NY,J) + OUTFLO(M,NY,J) 
 1075 CONTINUE
      NY = 2
 1085 DO 1110 M = 1,12
      IF(M .NE. 1 ) GO TO 1090
      DELTA(M,NY,J) = EOM(M,NY,J) - EOM(12, NY-1,J) 
      INFLOW(M,NY,J) = DELTA(M,NY,J) + OUTFLO(M,NY,J) 
      GO TO 1110
 1090 DELTA(M,NY,J) = EOM(M,NY,J) - EOM(M-1,NY,J) 
 1100 INFLOW(M,NY,J)= DELTA(M,NY,J) + OUTFLO(M,NY,J)
 1110 CONTINUE
 1120 CONTINUE
 1150 K = IDATA(2,L)
      IF(K - 11 )1275,1375,1175 
C 
C     SET RUNOFF FOR OUTPUT ON RUNOFF COMPUTATIONS
C 
 1175 JR = JR + 1 
      JB = 0
      DO 1190 N = 1,NMSITE
      IF(ITYPS(L,N) .EQ. JTYPS(12)) GO TO 1200
 1190 CONTINUE
      GO TO 1210
 1200 DO 1205 I = 1,3 
 1205 ROCNAM(I,JR) = NAMEST(I,N)
 1210 NY = 1
 1211 JB = JB + 1 
      DO 1212 I = 1,3 
      IF(NAMERO(I,JB) .NE. NAMEST(I,N)) GO TO 1214
 1212 CONTINUE
      GO TO 1216
 1214 IF(JB .LT. 10) GO TO 1211 
      JERR = 1
      WRITE(IOER,86) IEQUAT, (NAMEST(I,N), I = 1,3) 
   86 FORMAT(//' FORECAST SPECIFIED ',3A10/1H ,'RUNOFF DATA NOT LOCATED 
     1FOR ', 3A10)
      GO TO 1540
 1216 IF(IDATA(3,L) .EQ. IYEAR ) NY = 2 
      MC = 0
      KB = MB 
      IF(NY .EQ. 2) GO TO 1250
      DO 1220 M = MB,12 
      MC = MC + 1 
      ROCOMP(1,JR,MC) = EOM(M,NY,JB)
      ROCOMP(2,JR,MC) = DELTA(M,NY,JB)
      ROCOMP(3,JR,MC) = OUTFLO(M,NY,JB) 
      ROCOMP(4,JR,MC) = INFLOW(M,NY,JB)*SWGHT(L,N)
      IF(ROCOMP(4,JR,MC) .LT. 0) THEN
        SINFLO(M,NY,JB)= SINFLO(M,NY,JB)
        ELSE
        SINFLO(M,NY,JB)= SINFLO(M,NY,JB)+ INFLOW(M,NY,JB) *SWGHT(L,N) 
      END IF
      ROCOMP(5,JR,MC) = SINFLO(M,NY,JB) 
 1220 CONTINUE
      KB = 1
      NY = 2
 1250 MM = MUSE - 1 
      IF(IPNCHR .EQ. 1) MM = MM + 1 
      IF(MM .LT. KB ) GO TO 1540
      DO 1260 M = KB,MM 
      MC = MC + 1 
      ROCOMP(1,JR,MC) = EOM(M,NY,JB)
      ROCOMP(2,JR,MC) = DELTA(M,NY,JB)
      ROCOMP(3,JR,MC) = OUTFLO(M,NY,JB) 
      ROCOMP(4,JR,MC) = INFLOW(M,NY,JB) * SWGHT(L,N)
      IF(M .NE. KB) GO TO 1252
      IF(ROCOMP(4,JR,MC) .LT. 0) THEN
        SINFLO(M,NY,JB)= SINFLO(M,NY,JB)
        ELSE
        SINFLO(M,NY,JB)= SINFLO(M,NY,JB)+ INFLOW(M,NY,JB) * SWGHT(L,N)
      END IF
      GO TO 1258
 1252 IF(ROCOMP(4,JR,MC) .LT. 0) THEN
        SINFLO(M,NY,JB)= SINFLO(M-1,NY,JB)
        ELSE
        SINFLO(M,NY,JB)= SINFLO(M-1,NY,JB)+INFLOW(M,NY,JB) * SWGHT(L,N) 
      END IF
 1258 ROCOMP(5,JR,MC) = SINFLO(M,NY,JB) 
 1260 CONTINUE
      GO TO 1540
C 
C     COMPUTE X VALUE FOR ANTECEDENT RUNOFF 
C 
 1275 JG = 0
      JC = 0
      JD = 0
      KC = 2
      NY = 1
      KB = MB 
      KO = MO 
      IF(IDATA(3,L) .EQ. IYEAR ) NY = 2 
      DO 1280 M = 1,12
 1280 TOT(M) = 0.0
      WGHT = 1.0
      DO 1350 N = 1,NMSITE
      IF(ITYPS(L,N) .EQ. 1H  ) GO TO 1350 
      IF(ITYPS(L,N) .NE. JTYPS(10) ) GO TO 1282 
C     ANTECEDENT RUNOFF CODED "A"
      IF(MO .GE. MB ) GO TO 1281
      WRITE(IO,90)IX(LC),MNTH(MB), MNTH(MO), (MNTH(M), M= MB,12), 
     1(MNTH(M), M = 1,MO) 
      GO TO 2280
 1281 WRITE(IO,90) IX(LC),MNTH(MB), MNTH(MO), (MNTH(M), M=MB,MO)
   90 FORMAT(1H0, A2, ' - ', A3, '-', A3, ' ANTECEDENT RUNOFF ' / 1H ,
     128X, 'WGHT', 7(4X, A3,1X) )
!       FOLLOWING 4 STATEMENTS ADDED.  #3 ABOVE
 2280 DO 2285 M=1,12
      IF(EANTECD(M) .NE. 0.0) GO TO 1292
 2285 CONTINUE
      GO TO 1350
 1282 DO 1284 NA = 1,12 
      IF(ITYPS(L,N) .EQ. JTYPS(NA) ) GO TO 1285 
 1284 CONTINUE
 1285 IF(NA - 2)1286,1287,1288
 1286 JC = JC + 1 
      GO TO 1292
 1287 JG = JG + 1 
      GO TO 1292
 1288 JD = JD + 1 
      DO 1289 I = 1,3 
      IF(NAMERO(I,JD) .NE. NAMEST(I,N)) GO TO 1290
 1289 CONTINUE
      GO TO 1292
 1290 IF(JD .LT. 10) GO TO 1288 
      JERR = 1
      WRITE(IOER,86) IEQUAT, (NAMEST(I,N), I = 1,3) 
      GO TO 1540
 1292 IF(MO .GE. MB) GO TO 2292 
      KB = MB 
      KC = 1
      KO = 12 
      NY = 1
 2292 DO 1315 M = KB,KO 
!     FOLLOWING 7 STATEMENTS ADDED.  #3 ABOVE
      IF(ITYPS(L,N) .NE. 'A') GO TO 1293
      IF(M .GE. MUSE) THEN
        IF(NY .EQ. 1) GO TO 1315
        TOT(M)=TOT(M) + EANTECD(M)
        IEST(M,1,10)=1HE
        IESTX(L)=1HE
        GO TO 1315
      END IF
      GO TO 1315
 1293 IF(NA - 2 )1295,1300,1305 
 1295 TOT(M) = TOT(M) + CANAL(M,NY,JC)
      GO TO 1315
 1300 TOT(M) = TOT(M) + GAGE(M,NY,JG) 
      GO TO 1315
 1305 IF(NY .NE. 2 ) GO TO 1306 
      IF(M .GE. MUSE) GO TO 1309
 1306 IF(NA - 8)1307,1309,1311
 1307 TOT(M) = TOT(M) + INFLOW(M,NY,JD) * SWGHT(L,N)
      WGHT = SWGHT(L,N) 
      GO TO 1315
 1309 TOT(M) = TOT(M) + OUTFLO(M,NY,JD) 
      GO TO 1315
 1311 TOT(M) = TOT(M) + DELTA(M,NY,JD)
 1315 CONTINUE
      IF(MO .GE. MB .OR. KC .EQ. 2 ) GO TO 1350 
      NY = 2
      KC = 2
      KB = 1
      KO = MO 
      GO TO 2292
 1350 CONTINUE
      IF(MO .GE. MB) GO TO 1365 
      WRITE(IO,95)  WGHT,(TOT(M),IEST(M,1,10), M = MB,12),
     1(TOT(M),IEST(M,1,10),M=1,MO)
      GO TO 1370
 1365 WRITE(IO,95)  WGHT, (TOT(M),IEST(M,1,10), M = MB,MO) 
   95 FORMAT(1H0, 26X, F6.2,1X, 7(F6.2,A1, 1X) ) 
 1370 CONTINUE
      IF(IANTMO .EQ. 0) GO TO 1358
      IF(MO .GE. MB) GO TO 1354
      WRITE(IO,91) (WGHTM(M,L),M=MB,12),(WGHTM(M,L),M=1,MO)
      DO 1352 M=MB,12
      TOT(M)=TOT(M) * WGHTM(M,L)
 1352 CONTINUE
      DO 1353 M=1,MO
      TOT(M)=TOT(M)*WGHTM(M,L)
 1353 CONTINUE
      WRITE(IO,93) (TOT(M),IEST(M,1,10),M=MB,12),
     1(TOT(M),IEST(M,1,10),M=1,MO)
      GO TO 1356
 1354 WRITE(IO,91) (WGHTM(M,L),M=MB,MO)
   91 FORMAT(1H0,28X,'WGHT',1X,7(F6.2,2X))
      DO 1355 M=MB,MO
      TOT(M)=TOT(M)*WGHTM(M,L)
 1355 CONTINUE
      WRITE(IO,93) (TOT(M),IEST(M,1,10),M=MB,MO)
   93 FORMAT(' ',27X,'TOTAL ',7(F6.2,A1,1X))
 1356 DO 1357 M=1,12
      IF(TOT(M) .LE. 0) GO TO 1357
      XA(L)=XA(L)+TOT(M)
      X(LC)=X(LC) + TOT(M)
      IF(ny .eq. 1 .or. M .LT. MUSE) THEN
        XABOVE(LC)=XABOVE(LC)+TOT(M)
        XBELOW(LC)=XBELOW(LC)+TOT(M)
        ELSE
        XABOVE(LC)=XABOVE(LC)+TOT(M)*PCTABV
        XBELOW(LC)=XBELOW(LC)+TOT(M)*PCTBLW
      END IF
 1357 CONTINUE
      GO TO 1372
 1358 DO 1360 M = 1,12
      IF(TOT(M) .LE. 0) GO TO 1360
      XA(L) = XA(L) + TOT(M)*WGHTM(MO,L)
      X(LC)=X(LC) + TOT(M)*WGHTM(MO,L)
      IF(ny .eq. 1 .or. M .LT. MUSE) THEN
        XABOVE(LC)=XABOVE(LC)+TOT(M)*WGHTM(MO,L)
        XBELOW(LC)=XBELOW(LC)+TOT(M)*WGHTM(MO,L)
        ELSE
        XABOVE(LC)=XABOVE(LC)+TOT(M)*PCTABV*WGHTM(MO,L)
        XBELOW(LC)=XBELOW(LC)+TOT(M)*PCTBLW*WGHTM(MO,L)
      END IF
 1360 CONTINUE
      WRITE(IO,97) WGHTM(MO,L)
   97 FORMAT(73X, 'WGHT', F6.3 )
 1372 CALL PRNTX
      GO TO 1540
C 
C     COMPUTE NATURAL FLOW AND SET IT FOR OUTPUT ON RUNOFF COMPUTATIONS 
C 
 1375 JG = 0
      JC = 0
      JD = 0
      JN = 1
      MM = MUSE - 1 
      IF(IPNCHR .EQ. 1) MM = MM + 1 
      DO 1385 M = 1,24
      DO 1380 JA = 1,16 
 1380 NATURL(JA,M) = 0.0
 1385 CONTINUE
      NY = 1
      IF(IDATA(3,L) .EQ. IYEAR ) NY = 2 
      IF(NY .EQ. 2 ) GO TO 1395 
      MC = MB 
      MD = 12 
      ME = 1
      MF = MO 
      GO TO 1405
 1395 ME = MB 
      MF = MUSE- 1 
      IF(IPNCHR .EQ. 1) MF = MF + 1 
 1405 DO 1520 N = 1,NMSITE
      IF(ITYPS(L,N) .EQ. 1H  ) GO TO 1520 
      IF(ITYPS(L,N) .NE. JTYPS(11) ) GO TO 1420 
      DO 1415 I = 1,3 
 1415 NATNAM(I,15) = NAMEST(I,N)
      GO TO 1520
 1420 MC = 0
      DO 1422 NA = 1,12 
      IF(ITYPS(L,N) .EQ. JTYPS(NA)) GO TO 1424
 1422 CONTINUE
 1424 IF(NA - 2 )1425,1426,1427 
 1425 JC = JC + 1 
      GO TO 1428
 1426 JG = JG + 1 
      GO TO 1428
 1427 JD = JD + 1 
      DO 2427 I = 1,3 
      IF(NAMERO(I,JD) .NE. NAMEST(I,N)) GO TO 2429
 2427 CONTINUE
      GO TO 1428
 2429 IF(JD .LT. 10) GO TO 1427 
      JERR = 1
      WRITE(IOER,86) IEQUAT, (NAMEST(I,N), I = 1,3) 
      GO TO 1540
 1428 NZ = NY 
      IF(NY .EQ.2  ) GO TO 1430 
      MT = MB 
      MU = MD 
      GO TO 1440
 1430 MT = ME 
      MU = MF 
 1440 CONTINUE
 1455 DO 1480 M = MT,MU 
      MC = MC + 1 
      IF(NA-2)1457,1460,1470
 1457 NATURL(JN,MC) = CANAL(M,NZ,JC)
      NATURL(15,MC) = NATURL(15,MC) + CANAL(M,NZ,JC)
      GO TO 1480
 1460 NATURL(JN,MC) = GAGE(M,NZ,JG) 
      NATURL(15,MC) = NATURL(15,MC) + GAGE(M,NZ,JG) 
      GO TO 1480
 1470 IF(NA - 8)1472,1474,1476
 1472 NATURL(15,MC) = NATURL(15,MC) + INFLOW(M,NZ,JD) * SWGHT(L,N)
      GO TO 1480
 1474 NATURL(15,MC) = NATURL(15,MC) + OUTFLO(M,NZ,JD) 
      GO TO 1480
 1476 NATURL(JN,MC) =DELTA(M,NZ,JD) 
      NATURL(15,MC) = NATURL(15,MC) +DELTA(M,NZ,JD) 
 1480 CONTINUE
      IF(NZ .EQ. 2 ) GO TO 1520 
      NZ = 2
      GO TO 1430
 1520 CONTINUE
      MT = 1
      MU = MM 
      IF(MB .EQ. 1 .AND. NY .EQ. 2 ) GO TO 1524 
      IF(NY .EQ. 2 ) GO TO 1522 
      MU = 12 - MB + 1 + MM 
      GO TO 1524
 1522 MU = MM - MB + 1
 1524 DO 1530 M = MT,MU 
      IF(M .NE. 1 ) GO TO 1525
      IF(NATURL(15,M) .LT. 0) THEN
        NATURL(16,M) = NATURL(16,M)
        ELSE
        NATURL(16,M) = NATURL(16,M) + NATURL(15,M)
      END IF
      GO TO 1530
 1525 IF(NATURL(15,M) .LT. 0) THEN
        NATURL(16,M) = NATURL(16,M-1)
        ELSE
        NATURL(16,M) = NATURL(16,M-1) + NATURL(15,M)
      END IF
 1530 CONTINUE
 1540 CONTINUE
C 
C     PRINT BASIN RUNOFF DATA FOR LINE PRINTER
C 
      IF(JERR .EQ. 0 ) GO TO 1560 
      WRITE(IO,102) IEQUAT
  102 FORMAT(1H0, 'FORCAST ', 3A10, ' NOT COMPLETED BECAUSE OF ERRORS' /
     11H , ' CHECK ERROR FILE FOR MORE INFORMATION' ) 
      GO TO 570 
 1560 MM = MUSE - 1 
      IF(IPNCHR .EQ. 1) THEN 
!     CHANGED SUBSCRIPT OF MNTH FROM 1 TO 12. ie: #6 ABOVE  10/26/84
         IF(MNTHFC .EQ. MNTH(12)) THEN
           MM = MM + 1
         END IF
         KM = MM
         KB = 1
         KV = KM - KB + 1
         KZ = (12 - KV) * 6 + 3
      END IF
      KB = 1
      KO= MB - 1
      KM = MM 
      IF(MB .EQ. 1 ) GO TO 1562 
      IF(MM .GE. MB ) GO TO 1561
      KM = MM - MB + 13 
      GO TO 1562
 1561 KM = MM - MB + 1
 1562 JA = JR + JN
      IF(JR .EQ. 0 .AND. JN .GT. 0) GO TO 1594
      IF(JN .EQ. 0 ) GO TO 1580 
      IF(JR .EQ. 3 ) GO TO 1565 
      WRITE(IO,103) ((ROCNAM(I,N), I = 1,2), N = 1,JR ), (NATNAM(I,15), 
     1I = 1,2), ((IHEAD(I), I = 1,2), J = 1,JA) 
  103 FORMAT(1H0, 5X, 3(3X,2A10) / 1H , 'MONTH', 6X, 3(A6,4X,A6,7X)/) 
      GO TO 1568
 1565 WRITE(IO,104) ((ROCNAM(I,N), I = 1,2), N = 1,JR),  (NATNAM(I,15), 
     1I = 1,2),           ((IHEAD(I),I = 1,2), J = 1,JA ) 
  104 FORMAT(1H0, 5X, 4(3X,2A10) /1H , 'MONTH', 6X, 4(A6,4X,A6,7X) / )
!     NEXT STATEMENT INSERTED 1/18/85 #8
 1568 IF(MCURNT .EQ. MB) GO TO 1600
      DO 1570 M= KB,KM
      CALL DAYITOA(M,KM,IDAY,KDAY)
      KO = KO + 1 
      IF(KO .GT. 12) KO = 1 
      WRITE(IO,106) MNTH(KO),KDAY,((ROCOMP(I,N,M), I = 4,5), N = 1,JR),
     1(NATURL(N,M), N = 15,16)
  106 FORMAT(1H , 1X, A3, 1X,A2, 4(2F10.2, 3X) ) 
 1570 CONTINUE
      DO 1575 N = 1,JR
      WRITE(IOF,111) NMCF, IYEAR, MNTH(KO), (ROCNAM(I,N), I = 1,2), 
     1(X(J), J = 1,NMCF), ROCOMP(5,N,KM)
C     WRITE RUNOFF TO BE PUNCHED
      IF(IPNCHR .EQ. 0) GO TO 1575
      WRITE(21,112) (ROCNAM(I,N), I = 1,2),KV,(ROCOMP(4,N,M), M=KB,KM),
     1IYEAR 
 1575 CONTINUE
      WRITE(IOF,111) NMCF, IYEAR, MNTH(KO), (NATNAM(I,15), I = 1,2),
     1(X(J), J = 1,NMCF), NATURL(16,KM) 
C     WRITE NATURAL FLOW TO BE PUNCHED
      IF(IPNCHR .EQ. 0) GO TO 1600
      WRITE(21,112) (NATNAM(I,15), I=1,2),KV, (NATURL(15,M), M=KB,KM), 
     1IYEAR 
      GO TO 1600
 1580 WRITE(IO,108) ((ROCNAM(I,N), I = 1,2), N = 1,JR ) 
  108 FORMAT(1H0, 5X, 4(3X, 2A10) ) 
      WRITE(IO,110) ((IHEAD(I), I = 1,2), J = 1,JR) 
  110 FORMAT(1H , 'MONTH', 6X, 4(A6,4X, A6, 7X) / ) 
      IF(MUSE .EQ. MB ) GO TO 1600
      DO 1590 M = KB,KM 
      CALL DAYITOA(M,KM,IDAY,KDAY)
      KO = KO + 1 
      IF(KO .GT. 12) KO = 1 
      WRITE(IO,106) MNTH(KO),KDAY,((ROCOMP(I,N,M), I = 4,5), N = 1,JR) 
 1590 CONTINUE
      DO 1593 N = 1,JR
      WRITE(IOF,111) NMCF, IYEAR, MNTH(KO), (ROCNAM(I,N), I = 1,2), 
     1(X(J), J = 1,NMCF), ROCOMP(5,N,KM)
C     WRITE RUNOFF TO BE PUNCHED
      IF(IPNCHR .EQ. 0) GO TO 1593
      WRITE(21,112) (ROCNAM(I,N), I = 1,2),KV,(ROCOMP(4,N,M), M=KB,KM),
     1IYEAR 
 1593 CONTINUE
      GO TO 1600
C     USE NATURAL FLOW ONLY
 1594 WRITE(IO,108) (NATNAM(I,15), I = 1,2) 
      WRITE(IO,110) ((IHEAD(I), I = 1,2), J = 1,JN) 
!     NEXT STATEMENT INSERTED 1/18/85 #7
      IF(MCURNT .EQ. MB) GO TO 1600
      DO 1595 M = KB,KM 
      CALL DAYITOA(M,KM,IDAY,KDAY)
      KO = KO + 1 
      IF(KO .GT. 12) KO = 1 
      WRITE(IO,106) MNTH(KO),KDAY,(NATURL(N,M), N = 15,16) 
 1595 CONTINUE
      WRITE(IOF,111) NMCF, IYEAR, MNTH(KO), (NATNAM(I,15), I = 1,2),
     1(X(J), J = 1,NMCF), NATURL(16,KM) 
  111 FORMAT(I1,I4, A3, 2A10, 6F11.3 )
C     WRITE NATURAL FLOW TO BE PUNCHED
      IF(IPNCHR .EQ. 0) GO TO 1600
      WRITE(21,112) (NATNAM(I,15), I=1,2),KV, (NATURL(15,M), M=KB,KM), 
     1IYEAR 
  112 FORMAT(1H4, 2A10,I2/ 1H4, <KV>F6.1, <KZ>X, I4)
 1600 REWIND ICOE 
      READ(ICOE,113)ITYPE, KYEAR
  113 FORMAT(4A10, I4)
      NA = 6
      CALL CORFIL(NA,ITYPE) 
      IF(IERR .EQ. 0 ) GO TO 1610 
      WRITE(IOER,115)ITYPE
  115 FORMAT(// 'FILE SPECIFIED AS COEFFICIENT FILE NOT CORRECT' /
     1/1H , 'FILE SPECIFIED = ', 4A10 ) 
      END FILE IO 
      REWIND IO 
      STOP 17 
C 
C     LOCATE CORRECT COEFFICIENT FOR THIS BASIN 
C 
 1610 DO 1670 N = 1,JA
 1615 READ(ICOE,120,END=1620)(NAME(J,N),  J = 1,3), (COEF(J,N), J = 1,5) 
  120 FORMAT(3A10, 5F12.0)
      GO TO 1630
 1620 IF(JN .GT. 0 .AND. JA .EQ. N ) GO TO 1622 
      WRITE(IOER,130) IEQUAT, (ROCNAM(J,N), J = 1,3)
      GO TO 1624
 1622 WRITE(IOER,130)IEQUAT, (NATNAM(J,15), J = 1,3)
  130 FORMAT(// 'FORECAST SPECIFIED ', 3A10 /1H , 'COEFFICIENT FILE DOES
     1 NOT CONTAIN SITE SPECIFIED' /1H ,'COEFFICIENT SITE SPECIFIED = ',
     23A10 )
 1624 JERR = 1
      GO TO 1660
 1630 IF(JN .GT. 0 .AND. JA     .EQ. N ) GO TO 1640 
      DO 1635 J = 1,3 
      IF(NAME(J,N) .NE. ROCNAM(J,N) ) GO TO 1615
 1635 CONTINUE
      GO TO 1648
 1640 DO 1645 J = 1,3 
      IF(NAME(J,N) .NE. NATNAM(J,15)) GO TO 1615
 1645 CONTINUE
C 
C     COMPUTE FORECASTS 
C 
 1648 FRCAST(N) = 0.0 
      FRCABV(N) = 0.0 
      FRCBLW(N) = 0.0 
      WRITE(IOER,9000)
 9000 FORMAT('0','     X    XABOVE  XBELOW')
      DO 1650 J = 1,NMCF
      WRITE(IOER,9002) X(J), XABOVE(J), XBELOW(J)
 9002 FORMAT(' ', 3F8.2)
      FRCAST(N) = FRCAST(N) + COEF(J,N) * X(J)
      FRCABV(N) = FRCABV(N) + COEF(J,N) * XABOVE(J) 
      FRCBLW(N) = FRCBLW(N) + COEF(J,N) * XBELOW(J) 
 1650 CONTINUE
      FRCAST(N) = FRCAST(N) + COEF(NMCF+1,N)
      FRCABV(N) = FRCABV(N) + COEF(NMCF+1,N)
      FRCBLW(N) = FRCBLW(N) + COEF(NMCF+1,N)
      DATEFC(N) = FRCAST(N) - ROCOMP(5,N,KM)
      IF(JN .GT. 0 .AND. N .EQ. JA ) GO TO 1655 
      DATEFC(N) = FRCAST(N) - ROCOMP(5,N,KM)
      DATABV(N) = FRCABV(N) - ROCOMP(5,N,KM)
      DATBLW(N) = FRCBLW(N) - ROCOMP(5,N,KM)
      GO TO 1660
 1655 DATEFC(N) = FRCAST(N) - NATURL(16,KM) 
      DATABV(N) = FRCABV(N) - NATURL(16,KM) 
      DATBLW(N) = FRCBLW(N) - NATURL(16,KM) 
 1660 REWIND ICOE 
 1670 CONTINUE
      JF = NMCF + 1 
      IF(JERR .EQ. 0 ) GO TO 1680 
      WRITE(IO,102)IEQUAT 
      GO TO 570 
C 
C     PRINT BASIN RUNOFF DATA AND FORECASTS IF NO ERRORS IN DATA
C 
 1680 WRITE(IO,140) MNTH(MB), MNTH(MO), MNTH(MO), (IC(J), J = 1,NMCF) 
  140 FORMAT(1H0, 71X, A3, '-', A3, '   RUNOFF  DATE-', A3 /1H , 5X,
     1'BASIN', 25X, 4(A2, 6X ) )
      WRITE(IO,142) IC(5) 
  142 FORMAT(1H+, 67X,A2,2X,'FORECAST  TO DATE FORECAST' / )
      PCTABV = PCTABV * 100.0       
      PCTBLW = PCTBLW * 100.0       
      IF(JR .EQ. 0 ) GO TO 1685 
      DO 1682 I = 1,JR
      WRITE(IO,145) (NAME(J,I),   J = 1,3), (COEF(J,I), J = 1,NMCF) 
      WRITE(IO,146) COEF(JF,I),FRCAST(I),ROCOMP(5,I,KM),DATEFC(I) 
      WRITE(IO,148) PCTABV, FRCABV(I), DATABV(I), PCTBLW, FRCBLW(I),
     1DATBLW(I) 
!     FRCAST(I) ADDED TO WRITE STATEMENT 10/26/84
!     FORMAT 150 CHANGED TO HANDLE FRCAST(I) 10/26/84
      WRITE(22,150) MNTHFC,MNTH(MO),(NAME(J,I),J=1,3),DATEFC(I),
     1DATABV(I),DATBLW(I),FRCAST(I)
  150 FORMAT(1H4,2A3,2X,3A10,4F9.1)
 1682 CONTINUE
      IF(JN .EQ. 0 ) GO TO 570
 1685 WRITE(IO,145) (NAME(J,JA), J=1,3), (COEF(J,JA), J=1,NMCF) 
      WRITE(IO,146)COEF(JF,JA),FRCAST(JA),NATURL(16,KM),DATEFC(JA)
      WRITE(IO,148) PCTABV, FRCABV(JA), DATABV(JA), PCTBLW, FRCBLW(JA), 
     1DATBLW(JA)
!     FRCAST(JA) ADDED TO WRITE STATEMENT 10/26/84
      WRITE(22,150) MNTHFC,MNTH(MO),(NAME(J,JA),J=1,3),DATEFC(JA),
     1DATABV(JA),DATBLW(JA),FRCAST(JA)
  145 FORMAT(1H , 3A10, 4F8.4)
  146 FORMAT(1H+,62X,F8.2, 3F9.1) 
  148 FORMAT(27X, 'ASSUMING ', F5.0, '  NORMAL SUBSEQUENT CONDITIONS',
     1    F9.1, 9X, F9.1 )
      GO TO 570 
 1800 REWIND IO 
      STOP 1000 
      END 
      SUBROUTINE CORFIL(NA,ITYPE) 
C 
C     TEST IF CORRECT FILE TYPE HAS BEEN SPECIFIED
C 
      DIMENSION ITYPE(4), NTYPE(4,7)
      CHARACTER NTYPE*10,itype*10
      DATA NTYPE / 'PRECIPITAT',
     1'ION       ', 2*'          ', 'SNOW AND S', 'OIL MOISTU', 
     2'RE        ', '          ', 'RUNOFF    ', 3*'          ', 
     3'ESTIMATED ', 'PRECIPITAT', 'ION       ', '          ', 
     4'ESTIMATED ', 'SNOW AND S', 'OIL MOISTU', 'RE        ', 
     5'COEFFICIEN', 'T         ', 2*'          ',
     6'FORECAST E', 'QUATION   ', 2*'          '/
      IERR = 0
      DO 100 I = 1,4
      IF(ITYPE(I) .NE. NTYPE(I,NA)) GO TO 120 
  100 CONTINUE
      GO TO 140 
  120 IERR = 1
      JERR = 1
  140 RETURN
      END 
      SUBROUTINE PRNTX
C     PRINT X VALUES
      COMMON/PRNT/ XA(8), IXA(4), IESTX(8), IX(4), IDATA(5,8), X(4),
     1             IXEST, LD, L, LC 
      IO = 6
      IF(IXEST .EQ. 1H  .AND. IESTX(L) .EQ. 1HE ) IXEST = 1HE 
      LD = LD + 1 
      IF(IDATA(1,L+1) .NE. LC) GO TO 120
      WRITE(IO,66) IX(LC), IXA(LD), XA(L), IESTX(L) 
   66 FORMAT(1H+, 84X, A2, A1, '=', F8.2, A1 )
      RETURN
  120 IF(L .EQ. 1 ) GO TO 130 
      IF(IDATA(1,L-1).NE. LC ) GO TO 130
      WRITE(IO,66) IX(LC), IXA(LD), XA(L), IESTX(L) 
  130 WRITE(IO,67) IX(LC), X(LC), IXEST 
   67 FORMAT(1H+, 100X, A2, '=', F8.2, A1 ) 
      LD = 0
      IXEST = ' '
      RETURN
      END 
      SUBROUTINE DAYITOA(M,KM,IDAY,KDAY)
C     CONVERT INTEGER DAY NUMBER TO ALPHA DAY NUMBER
      CHARACTER KDAY*2
      KDAY='  '
      IF(M .EQ. KM) THEN
        IF(IDAY .LE. 1) GO TO 150
        WRITE(KDAY,'(I2)') IDAY
      END IF
  150 RETURN
      END
